home *** CD-ROM | disk | FTP | other *** search
/ Amiga Plus Special 16 / AMIGAplus Sonderheft 16 (1998)(ICP)(DE)[!].iso / pd / anwendungen / amicad / arexx_english / truthtable.amicad < prev    next >
Text File  |  1998-08-09  |  3KB  |  121 lines

  1. /* Creates a verity table (TruthTable)
  2.    $VER: 1.01e (9 août 1998, © R.Florac) */
  3.  
  4. options results
  5.  
  6. signal on error
  7. signal on syntax
  8.  
  9. 'ASK("Number of inputs")'; nbe=result
  10. if nbe="" then exit
  11.  
  12. l=0
  13. do i=1 to nbe
  14.     'ASK("Name of input #'i'")'; nomE.i=result
  15.     'TXWIDTH("'nomE.i'")'; lc=result
  16.     if lc>l then l=lc
  17. end
  18.  
  19. 'ASK("Number of outputs")'; nbs=result
  20. if nbs="" then exit
  21.  
  22. do i=1 to nbs
  23.     'ASK("Name of output #'i'")'; nomS.i=result
  24.     'TXWIDTH("'nomS.i'")'; lc=result
  25.     if lc>l then l=lc
  26. end
  27.  
  28. 'SETSCALE(0,1,1):ROTATE(0,0):SYMMETRY(0,0):DRAWMODE(1)'
  29.  
  30. nbl=2**nbe    /* number of lines */
  31.  
  32. l=l+20
  33. do i=1 to nbe
  34.     cole.i=10+l*i
  35.     '(TXWIDTH("'nomE.i'")-TXWIDTH("0"))/2'
  36.     'MARK(WRITE("'nomE.i'", 'cole.i-result', 20))'
  37. end
  38.  
  39. do i=1 to nbs
  40.     cols.i=10+l*(i+nbe)
  41.     '(TXWIDTH("'nomS.i'")-TXWIDTH("0"))/2'
  42.     'MARK(WRITE("'nomS.i'", 'cols.i-result', 20))'
  43. end
  44.  
  45. do c=1 to nbe
  46.     ng=2**c
  47.     ligne=1
  48.     do i=1 to ng/2
  49.     do j=1 to nbl/ng
  50.         'MARK(WRITE("0", 'cole.c', 20+'ligne'*15))'
  51.         val.c.ligne=0
  52.         ligne=ligne+1
  53.     end
  54.     do j=j to nbl/ng*2
  55.         'MARK(WRITE("1", 'cole.c', 20+'ligne'*15))'
  56.         val.c.ligne=1
  57.         ligne=ligne+1
  58.     end
  59.     end
  60. end
  61.  
  62. /* Vertical lines */
  63. col=cole.1-l%2+5
  64. do c=1 to nbe+nbs+1
  65.     select
  66.     when c=1 then 'DRAWMODE(2)'
  67.     when c=nbe+1 then 'DRAWMODE(2)'
  68.     when c=nbe+nbs+1 then 'DRAWMODE(2)'
  69.     otherwise 'DRAWMODE(1)'
  70.     end
  71.     'MARK(DRAW('col',8,'col',23+'nbl'*15))'
  72.     col=col+l
  73. end
  74.  
  75. /* Horizontal lines */
  76. ligne=8
  77. do i=1 to nbl+2
  78.     select
  79.     when i=1 then 'DRAWMODE(2)'
  80.     when i=2 then 'DRAWMODE(2)'
  81.     when i=nbl+2 then 'DRAWMODE(2)'
  82.     otherwise 'DRAWMODE(1)'
  83.     end
  84.     'MARK(DRAW('cole.1-l%2+5','ligne','col-l','ligne'))'
  85.     ligne=ligne+15
  86. end
  87.  
  88. 'DRAWMODE(1):REQUEST("Do you want to fill the table?")'
  89. if result=1 then do
  90.     'DEF OR(A,B)=IF(A+B,1,0)'
  91.     'DEF AND(A,B)=IF(A*B,1,0)'
  92.     'DEF NOT(A)=IF(A,0,1)'
  93.     'DEF NAND(A,B)=NOT(AND(A,B))'
  94.     'DEF NOR(A,B)=NOT(OR(A,B))'
  95.     'DEF XOR(A,B)=IF(A+B==1,1,0)'
  96.     do i=1 to nbs
  97.     'ASK("'nomS.i' equation?"+CHR(10)+"You can use the"+CHR(10)+"functions NOT(A),"+CHR(10)+"AND(A,B), OR(A,B), XOR(A,B)"+CHR(10)+"NAND(A,B) et NOR(A,B)."+CHR(10)+"Use the variable names like"+CHR(10)+"you gave them for inputs.")'
  98.     eq=result
  99.     if eq~= "" then do
  100.         do ligne=1 to nbl
  101.         do j=1 to nbe
  102.             'EXEC("'nomE.j'='val.j.ligne'")'
  103.         end
  104.         'EXEC("'eq'")'; r=result
  105.         'MARK(WRITE("'r'",'cols.i','20+ligne*15'))'
  106.         end
  107.     end
  108.     end
  109. end
  110.  
  111. exit
  112.  
  113. syntax:
  114. erreur=RC
  115. 'MESSAGE("Script TruthTable"+CHR(10)+"Syntax error"+CHR(10)+"in line 'SIGL'"+CHR(10)+"'errortext(erreur)'")'
  116. exit
  117.  
  118. error:
  119. 'MESSAGE("Script TruthTable"+CHR(10)+"Error in line 'SIGL'")'
  120. exit
  121.